PROGRAM kruununhaka
  !-------------------------------------------------------------------
  ! This is the user interface and the main program for  
  ! KRUUNUNHAKA BASIS SET TOOL KIT
  ! contact: pekka.manninen@csc.fi
  !
  ! http://www.chem.helsinki.fi/~manninen/kruununhaka
  !
  !-------------------------------------------------------------------
  !
  ! Copyright (C) 2004-2008 Pekka Manninen
  !                    2010 Jussi Lehtola
  !
  ! This program is distributed under the terms of the GNU General
  ! Public License as published by the Free Software Foundation;
  ! either version 2 of the License, or (at your option) any later version.
  !
  ! This program is distributed in the hope that it will be useful,
  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
  !
  ! Please note, that the author must be properly cited whenever 
  ! this program or some parts originated on it are employed.
  !
  !-------------------------------------------------------------------
  ! See CHANGELOG for revision history 
  !-------------------------------------------------------------------
  ! Uses modules
  !   krun_def.f90   : public parameters
  !   comp_prof.f90  : computation of the basis set completeness
  !                    profiles
  !   bas_opt.f90    : optimization routines for co primitive sets
  !   cont_opt.f90   : optimization routines for co set contraction
  !-------------------------------------------------------------------

  USE definitions
  USE textutil
  USE menu

  USE menu_contr
  USE menu_prim
  USE menu_read
  USE menu_save
  USE menu_plot

  IMPLICIT NONE

  EXTERNAL rnd_alloc
  EXTERNAL rnd_free

  ! Exponents and contraction coefficients
  REAL(KIND=prec), DIMENSION(:,:), ALLOCATABLE :: X_l
  REAL(KIND=prec), DIMENSION(:,:,:), ALLOCATABLE :: C_l
  INTEGER, DIMENSION(MAXL,2) :: nbas
  
  ! Main menu
  CHARACTER(LEN=9) :: mainmenu_tit="Main menu"
  CHARACTER(LEN=TERMWIDTH), DIMENSION(8) :: mainmenu
  CHARACTER(LEN=8) :: mainsel

  CHARACTER(LEN=TERMWIDTH), DIMENSION(3) :: mainmenu_nobas
  CHARACTER(LEN=3) ::  mainsel_nobas

  ! Current state of basis set
  CHARACTER(LEN=TERMWIDTH), DIMENSION(MAXL+2) :: basisstate

  INTEGER :: j, k, l ! Loop indices
  INTEGER :: sel ! Selection

  ! Helper variable for printout
  CHARACTER(LEN=20) :: printform

  ! Initialize number of basis functions
  nbas=0

  ! Allocate random number generator
  CALL rnd_alloc()

  ! Print header
  CALL print_vertbar('=')
  CALL print_centerbar('KRUUNUNHAKA basis set tool kit','=')
  CALL print_centerbar('        version 2.0.1         ','=')
  CALL print_vertbar('=')
  CALL print_center('pekka.manninen@csc.fi',' ')
  CALL print_center('jussi.lehtola@helsinki.fi',' ')
  CALL print_vertbar('-')

  WRITE (*,*) ''

  ! Main menu, when basis set in memory
  mainmenu(1)='Read in basis set from file'
  mainmenu(2)='Generate completeness-optimized primitive set'
  mainmenu(3)='Generate completeness-optimized contraction'
  mainmenu(4)='Plot completeness profile'
  mainmenu(5)='View the basis set'
  mainmenu(6)='Save basis set to file'
  mainmenu(7)='Drop basis set from memory'
  mainmenu(8)='Exit program'
  ! Selection values
  mainsel='1234567q'

  ! Main menu, when no basis set in memory
  mainmenu_nobas(1)='Read in basis set from file'
  mainmenu_nobas(2)='Generate completeness-optimized primitive set'
  mainmenu_nobas(3)='Exit program'
  mainsel_nobas='12q'

  DO WHILE(.TRUE.)
     ! Prepare state of basis set
     write(basisstate(1),'(A31,A)') ' ','Current basis set'
     call writencx(basisstate(2:MAXL+2),nbas)


     IF(ALLOCATED(X_l) .AND. ALLOCATED(C_l)) THEN
        sel=make_cvals_selection(mainmenu_tit,basisstate,mainmenu,mainsel,'*')
        
        SELECT CASE(sel)
        CASE(1)
           CALL read_menu(X_l,C_l,nbas)
        CASE(2)
           CALL prim_menu(X_l,C_l,nbas)
        CASE(3)
           CALL contr_menu(X_l,C_l,nbas)
        CASE(4)
           CALL plot_menu(X_l,C_l,nbas)
        CASE(5)
           DO l = 1, MAXL
              WRITE(printform,'(A9,I0,A6)') '(E16.8,A,', nbas(l,2), 'E16.8)'
              IF(nbas(l,1) /= 0) THEN
                 WRITE(*,'(A,A,A)') '! ', l_name(l), &
                      '-TYPE FUNCTIONS'
                 WRITE(*,'(A,I4,I4)') 'H', nbas(l,1), nbas(l,2)
                 
                 DO j = 1, nbas(l,1)
                    WRITE(*,printform) X_l(l,j), ' ', &
                         (C_l(l,j,k), k=1,nbas(l,2))
                 END DO
              END IF
           END DO
        CASE(6)
           CALL save_menu(X_l,C_l,nbas)
        CASE(7)
           IF(make_yn('This will drop the current basis set from memory.')) THEN
              DEALLOCATE(X_l)
              DEALLOCATE(C_l)
              nbas=0
           END IF
        CASE(8)
           CALL rnd_free()
           STOP
        END SELECT
     ELSE
        sel=make_cvals_selection(mainmenu_tit,basisstate,mainmenu_nobas,mainsel_nobas,'*')

        SELECT CASE(sel)
        CASE(1)
           CALL read_menu(X_l,C_l,nbas)
        CASE(2)
           CALL prim_menu(X_l,C_l,nbas)
        CASE(3)
           IF(ALLOCATED(C_l)) DEALLOCATE(C_l)
           IF(ALLOCATED(X_l)) DEALLOCATE(X_l)
           CALL rnd_free()
           STOP
        END SELECT
     END IF

  END DO

CONTAINS

  SUBROUTINE writencx(str,nbas)
    ! Write status of basis set in str
    IMPLICIT NONE

    CHARACTER(LEN=*), DIMENSION(MAXL+1), INTENT(OUT) :: str
    INTEGER, DIMENSION(MAXL,2), INTENT(IN) :: nbas

    INTEGER :: l

    WRITE(str(1),'(A35,A)') ' ','   nx  nc  '
    DO l=1,MAXL
       WRITE(str(l+1),'(A35,A,A,I3,A,I3)') ' ',l_name(l),' ',nbas(l,1),' ',nbas(l,2)
    END DO
  END SUBROUTINE writencx
    

END PROGRAM kruununhaka
